home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_tkcvs.idb / usr / freeware / lib / tkcvs / static.tcl.z / static.tcl
Encoding:
Text File  |  1999-04-16  |  927 b   |  42 lines
  1. #
  2. # $Id: static.tcl,v 1.1 1995/03/05 00:04:11 del Exp $
  3. #
  4. #  DESCRIPTION
  5. #      This file contains a procedure written in Tcl that supports static 
  6. #      variables.
  7. #
  8. #+ static - static variables support
  9. #
  10. #    This procedure supports static variables for a procedure whole through
  11. #    Tcl code.  This procedure is based on code from the authors of the
  12. #    tclX extension.
  13. #
  14. # REQUIREMENTS
  15. #    None.
  16. #
  17. # RETURNS
  18. #    Nothing.
  19. #
  20. # EXAMPLE
  21. #    static {foo 10} bar
  22. #
  23. # CAVEATES
  24. #    None.
  25. #
  26. proc static {args} {
  27.     global staticvars
  28.     set procName [lindex [info level -1] 0]
  29.     foreach varPair $args {
  30.     set varName [lindex $varPair 0]
  31.     if {[llength $varPair] != 1} {
  32.         set varValue [lrange $varPair 1 end]
  33.     } else {
  34.         set varValue {}
  35.     }
  36.     if {! [info exists staticvars($procName:$varName)]} {
  37.         set staticvars($procName:$varName) $varValue
  38.     }
  39.     uplevel 1 "upvar #0 staticvars($procName:$varName) $varName"
  40.     }
  41. }
  42.